perm filename CONTRL.SAI[SYS,HE]1 blob
sn#004166 filedate 1972-10-16 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 BEGIN "CONTRL"
00009 00003 GET VALUE OF VARIABLE
00011 00004 HERE ARE OUR MESSAGE PROCEDURES
00020 00005 MAIN PROGRAM STARTS HERE
00023 00006 CASE I OF
00026 ENDMK
⊗;
BEGIN "CONTRL"
REQUIRE "HELIB.REL[1,3]" LIBRARY;
REQUIRE 100 SYSTEM_PDL;
REQUIRE 500 STRING_SPACE;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
DEFINE CX="14",TTY="1", LPT="2",
CR="'15", LF="'12", CRLF="CR&LF", TAB="'11", TJOB="EQU(""TTY"",JOB)";
SAFE INTEGER ARRAY LPSFRE[1:1000];
PRELOAD_WITH "DISK","DEBUG","SETVAL","FIND","FIT","INSIDE",
"COMPACT","REJECT","RELOOK","FINE","GETDATA","GETVAL","GUNTRACE","START";
SAFE STRING ARRAY COMND[0:CX];
PRELOAD_WITH 1,'12,'32,6,6,6,6,6,6,6,6,2,'36,1;
SAFE INTEGER ARRAY STATBITS[0:CX];
INTEGER I,J,BRK,ARG,TARG,STATUS,BITS, ARGT;
EXTERNAL INTEGER XSTRT, YSTRT, TVWORD, PTYDPY, DISSIZ,INIT;
BOOLEAN FLAGX, AFLAG, FLAG, FLAGY;
STRING ANS, VERB, ARGSTR, ARGTWO, DSKSTRING, INP;
LABEL INPT, INPTX, ERRCOM, ERRARG, XEQL;
EXTERNAL BOOLEAN ACCOMINIT, EDGINIT;
INTERNAL STRING JOB;
ITEMVAR IARG, T;
EXTERNAL BOOLEAN PROCEDURE LOOK(REFERENCE ITEMVAR ARG; REFERENCE INTEGER ING; INTEGER X, Y);
EXTERNAL INTEGER PROCEDURE XGETD(ITEMVAR ARG; STRING JOB);
EXTERNAL PROCEDURE INITLPS(INTEGER A);
EXTERNAL PROCEDURE DISINT;
EXTERNAL BOOLEAN PROCEDURE INITDK(STRING NAME);
EXTERNAL PROCEDURE SEINT(INTEGER A, B, C, D, E);
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE INSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE REJSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE COMP(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE XFINE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE FINSCN(SET BLOBS; INTEGER FILE; REFERENCE INTEGER STATUS);
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL BOOLEAN PROCEDURE SUBLNK(STRING FOO);
EXTERNAL PROCEDURE INTINT(BOOLEAN A,B,C);
EXTERNAL INTEGER PROCEDURE SLINK(STRING NAME);
EXTERNAL PROCEDURE INITTV;
EXTERNAL PROCEDURE DEFLT;
EXTERNAL PROCEDURE INTWAIT;
COMMENT BITS IN STATBITS FOR COMMAND DECODER
1 NO ARGUMENTS
2 ONE ARGUMENT EXISTS
4 ARGUMENT IS NUMBER
10 SECOND ARGUMENT EXISTS
20 SECOND ARGUMENT IS NUMBER;
COMMENT GET VALUE OF VARIABLE;
SIMPLE PROCEDURE GETVAL(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
BEGIN INTEGER I, FLG;
REAL J;
FLG ← FALSE;
IF FLAG←(I←SLINK(ARGSTR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,I;
MOVE 1,(1);
MOVEM 1,I;
MOVEM 1,J;
TLNE 1,'777000;
SETOM FLG;
END ELSE RETURN;
SETFORMAT(10,4);
OUTSTR((IF ¬FLG THEN (CVOS(I)&CVS(I)) ELSE (CVF(J)))&CRLF);
FLAG ← TRUE;
END;
SIMPLE INTEGER PROCEDURE FOOL(REAL A);
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,A;
END;
COMMENT SCAN ONE LINE FOR NEXT WORD OR NUMBER
STRING A IS EATEN AS SCANNED
B IS BREAK CHAR
FLAGX (GLOBAL) IS TRUE IF STRING IS A NUMBER
FLAGY (GLOBAL) IS TRUE IF A FLOATING POINT NUMBER IS SEEN;
SIMPLE STRING PROCEDURE SCN(REFERENCE STRING A; REFERENCE INTEGER B);
BEGIN STRING FOO, FA;
INTEGER C;
FA ← FOO ← SCAN(A,1,B);
SCAN(FA,2,C);
FLAGX ← ¬C;
SCAN(FA←FOO,3,C);
FLAGY←C;
RETURN(FOO);
END;
COMMENT HERE ARE OUR MESSAGE PROCEDURES;
COMMENT RESPONSE PROCEDURE;
SIMPLE PROCEDURE RESP(ITEMVAR ARG; INTEGER STATUS; STRING NAME);
IF TJOB THEN
BEGIN
AFLAG ← TRUE;
OUTSTR(NAME&(IF ARG=EVERY THEN " EVERY" ELSE " "&CVS(CVN(ARG)))
&" "&CVS(STATUS)&CRLF);
END ELSE ISSUE(5,"EDGE",JOB,MESSAGE RESPONSE(NAME,CVN(ARG),STATUS));
DEFINE PROC(A,B)="
MESSAGE PROCEDURE A(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
B(ARG,STATUS←0);
RESP(ARG,STATUS,""A"");
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
END";
MESSAGE PROCEDURE FIND(ITEMVAR ARG);
BEGIN ITEMVAR T;
T ← ARG;
DO BEGIN
EDGE_KKP(ARG,STATUS);
IF T=EVERY∧ARG≠NIL THEN ARG←T;
END UNTIL T≠EVERY∨ARG=NIL;
RESP(NIL,-1,"FIND");
IF ARG=NIL THEN XSTRT←YSTRT←0;
END;
MESSAGE PROCEDURE GUNTRACE(SET BLOBS;INTEGER FILE);
BEGIN BOOLEAN STATUS;
FINSCN(BLOBS, FILE, STATUS);
RESP(NIL,STATUS,"GUNTRACE");
END;
PROC(FIT,CURVE);
PROC(INSIDE,INSUB);
PROC(COMPACT,COMP);
PROC(REJECT,REJSUB);
PROC(FINE,XFINE);
MESSAGE PROCEDURE RELOOK(ITEMVAR ARG; INTEGER X,Y);
BEGIN
LOOK(ARG,STATUS,X,Y);
RESP(ARG,STATUS,"RELOOK");
END;
SIMPLE MESSAGE PROCEDURE XEQ(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
IF EQU(ARGSTR,"START") THEN XSTRT←YSTRT←0 ELSE FLAG←¬SUBLNK(ARGSTR);
SIMPLE MESSAGE PROCEDURE DEBUG(STRING ARGSTR, ARGTWO; REFERENCE BOOLEAN FLAG);
BEGIN INTEGER I;
IF EQU(ARGTWO,"ON") THEN I ← 4 ELSE IF
EQU(ARGTWO,"OFF") THEN I ← 3 ELSE BEGIN FLAG←FALSE;RETURN;END;
FLAG ← ¬SUBLNK(ARGSTR[1 FOR I]&ARGTWO);
END;
SIMPLE MESSAGE PROCEDURE SETVAL(STRING ARGSTR; INTEGER ARG; REFERENCE BOOLEAN FLAG);
BEGIN
EDGINIT ← FALSE;
IF FLAG ← (I ← SLINK(ARGSTR))>0 THEN
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,ARG;
MOVE 2,I;
MOVEM 1,(2);
END;
END;
MESSAGE PROCEDURE GETDATA(ITEMVAR ARG; REFERENCE BOOLEAN FLAG);
BEGIN
FLAG ← ¬XGETD(ARG, JOB);
END;
INTERNAL PROCEDURE RESTART;
BEGIN
AFLAG←TRUE;
DISINT;
SEINT(0,0,0,0, 0);
INITLPS(GIOWD(LPSFRE));
INITTV;
INP ← NULL;
DEFLT;
END;
SIMPLE MESSAGE PROCEDURE DISK(STRING NAME; REFERENCE BOOLEAN FLAG);
FLAG ← INITDK(NAME);
COMMENT MAIN PROGRAM STARTS HERE;
PTYDPY ← DISDEV;
ACCOMINIT ← FALSE;
SETBREAK(1,LF&" ,",NULL,"I");
SETBREAK(2,"0123456789.-",NULL,"X");
SETBREAK(3,".",NULL,"I");
SETBREAK(4,LF,"","IA");
TVWORD ← 0;
PUT_DATA(0,0,"EDGE");
YES_EDGE ← TRUE;
INIT ← FALSE;
INTINT(TRUE,FALSE,TRUE);
RESTART;
INPT: WHILE (I ← GET_ENTRY('40120,"","EDGE","")) DO
BEGIN
JOB ← GET_DATA(1,I);
I ← QUEUE('600,I);
END;
IF AFLAG THEN BEGIN OUTSTR("*"&CRLF); AFLAG ← FALSE; END;
WHILE LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX DO BEGIN INP←INP&ANS&LF;ANS←NULL;END;
IF ¬LENGTH(INP) THEN GO TO XEQL;
JOB←"TTY";
AFLAG ← TRUE;
WHILE LENGTH(ANS←SCAN(INP,4,BRK)) DO
BEGIN
IF ¬LENGTH(VERB←SCN(ANS,BRK)) THEN GO TO INPTX;
FOR I ← 0 STEP 1 UNTIL CX DO IF EQU(VERB,COMND[I]) THEN DONE;
IF I>CX THEN GO TO ERRCOM;
BITS ← STATBITS[I];
IF BITS LAND 2 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE ARGSTR←SCN(ANS,BRK);
IF BITS LAND 4 THEN IF FLAGX THEN
ARG←(IF FLAGY THEN FOOL(REALSCAN(ARGSTR,LF)) ELSE
CVD(ARGSTR)) ELSE GO ERRARG ELSE
ARGSTR ← ARGSTR[1 FOR 6];
IF BITS LAND '10 THEN
BEGIN
IF BRK=LF THEN GO TO ERRARG ELSE ARGTWO←SCN(ANS,BRK);
IF BITS LAND '20 THEN IF FLAGX THEN
ARGT←(IF FLAGY THEN FOOL(REALSCAN(ARGTWO,LF))
ELSE CVD(ARGTWO)) ELSE GO TO ERRARG
ELSE ARGTWO ← ARGTWO[1 FOR 6];
END;
END;
IARG ← IF ARG>0 THEN CVI(ARG) ELSE IF ARG=0 THEN NIL ELSE EVERY;
FLAG ← TRUE;
CASE I OF
BEGIN
BEGIN
IF LENGTH(ANS) THEN DSKSTRING ← ANS[1 TO ∞-1];
DISK(DSKSTRING,FLAG);
IF ¬FLAG THEN OUTSTR(CRLF&DSKSTRING&" NOT FOUND"&CRLF);
END;
DEBUG(ARGSTR, ARGTWO, FLAG);
SETVAL(ARGSTR,ARGT, FLAG);
FIND(IARG);
FIT(IARG);
INSIDE(IARG);
COMPACT(IARG);
REJECT(IARG);
RELOOK(IARG,0,0);
FINE(IARG);
GETDATA(IF ARG<0 THEN EVERY ELSE CVI(ARG),FLAG);
GETVAL(ARGSTR,FLAG);
GUNTRACE({IARG},ARGT);
YSTRT ← XSTRT ← 0;
END;
IF ¬FLAG THEN
ERRARG: OUTSTR("ARG ERR"&TAB&ANS&CRLF);
INPTX: END;
GO TO INPT;
XEQL: IF GET_ENTRY('40120,NULL,"EDGE",NULL) THEN GO TO INPT;
IF LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX THEN
BEGIN
INP←INP&ANS&LF;
GO TO INPT;
END;
INTWAIT;
GO TO INPT;
ERRCOM: IF SUBLNK(VERB) THEN OUTSTR("COM ERR "&VERB&CRLF);
GO TO INPT;
END;